{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Majalan.Base.CSD
-- Copyright   :  (c) Stephen Tetley 2014
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- CsDoc - line oriented Doc type with an include directive.
--
-- Plus helpers to run generated CSD file via shelling out.
-- 
--------------------------------------------------------------------------------

module Majalan.Base.CSD
  (

    ErrMsg
  , Flag(..)
  , Options 
  , odac
  , oaiff
  , owav

  , genCSD
  , makeCSD

  , shellTest

  ) where



-- package: pretty
import Text.PrettyPrint.HughesPJ

import Control.Monad ( void )
import System.Directory ( doesFileExist )
import System.Environment ( getEnv )
import System.FilePath ( (</>) )
import System.IO.Error ( catchIOError )
import System.Process ( system )

type ErrMsg = String


data Flag = Wav                                 --  -W
          | Aiff                                --  -A
          | Output FilePath                     --  -o FILE
          | Input FilePath                      --  -i FILE
          | NoDisplays                          --  --nodisplays
          | Displays                            --  --displays
          | NoSound                             --  --nosound
          | Verbose                             --  -v
          | OtherFlag String (Maybe String)
  deriving (Eq,Show)

type Options = [Flag]

odac                    :: Options
odac                    = [Output "dac"]


oaiff                   :: FilePath -> Options 
oaiff path              = [Output path, Aiff]

owav                    :: FilePath -> Options
owav path               = [Output path, Wav]


ppFlag :: Flag -> Doc
ppFlag (Wav)            = text "-W"
ppFlag (Aiff)           = text "-A"
ppFlag (Output s)       = text "-o" <+> text s
ppFlag (Input s)        = text "-i" <+> text s
ppFlag (NoDisplays)     = text "--nodisplays"
ppFlag (Displays)       = text "--displays"
ppFlag (NoSound)        = text "--nosound"
ppFlag (Verbose)        = text "-v"
ppFlag (OtherFlag s mb) = maybe (text s) (\a -> text s <+> text a) mb

flags :: [Flag] -> Doc
flags = hsep . map ppFlag





genCSD :: Options -> FilePath -> Doc -> IO (Either ErrMsg String)
genCSD opts orc_path sco = do 
    ok <- doesFileExist orc_path
    if ok then do { orc <- readFile orc_path
                  ; return $ Right $ makeCSD opts orc sco
                  }
          else return $ Left $ "Cannot find orchestra: " ++ orc_path

makeCSD :: Options -> String -> Doc -> String
makeCSD opts orc sco = renderStyle sty $ 
    encloseTag "CsoundSynthesizer" $ options $+$ insts $+$ score
  where
    options   = encloseTag "CsOptions" $ flags opts
    insts     = encloseTag "CsInstruments" (zeroWidthText orc)
    score     = encloseTag "CsScore" sco
    sty       = Style { mode = LeftMode
                      , lineLength = 400
                      , ribbonsPerLine = 1.5 }
                


encloseTag :: String -> Doc -> Doc
encloseTag s d = open $+$ d $+$ cloz
  where 
    open = text $ '<' : s ++ ">"
    cloz = text $ '<' : '/' : s ++ ">"




get_MAJALAN_TEMP_DIR :: IO (Maybe String)
get_MAJALAN_TEMP_DIR = 
    catchIOError (fmap Just $ getEnv "MAJALAN_TEMP_DIR") 
                 (const $ return Nothing)



-- | Needs environment variable MAJALAN_TEMP_DIR defining...
--
shellTest :: Options -> FilePath -> Doc -> IO ()
shellTest opts orc sco = do 
    ans1 <- genCSD opts orc sco 
    case ans1 of 
      Left err -> putStrLn $ err
      Right ss -> do 
          ans2 <- get_MAJALAN_TEMP_DIR
          case ans2 of
            Nothing -> fk2
            Just root -> let temp_file = root </> "temp.csd" in do 
                writeFile temp_file ss 
                void $ system $ "csound " ++ temp_file
  where
    fk2 = putStrLn $ "Environment variable MAJALAN_TEMP_DIR not defined."